Attribute VB_Name = "modSmartPost"
Public g_strSPDUNS As String            'Customer SmartPost DUNS # from Setup
Public g_strDCB As String               'Delivery Confirmation Barcode
Public g_str11USPS As String            'USPS Company name
Public g_str12USPS As String            'USPS Contact name included in transaction
Public g_str13USPS As String            'USPS Addr 1
Public g_str15USPS As String            'USPS City
Public g_str16USPS As String            'USPS State
Public g_str17USPS As String            'USPS Zip
Public g_str17USPSActual As String      'USPS Deliver-To Zip
Public g_strClass As String             'SP Postal CLASS
Public g_strSubClass As String          'SP Postal Sub-class
Public g_strEndorsement As String       'Ancillary Endorsement
Public g_strFTPURL As String            'SP FTP URL
Public g_strFTPUID As String            'SP FTP UserID
Public g_strFTPPWD As String            'SP FTP Password
Public g_strFTPProxy As String          'SP FTP Proxy
Public g_strZone As String              'SP Zone for Rating
Public g_blnNoDelConfirm As Boolean       'Used to indicate Del Confirmation
'---------------------------------------------------------------------------------------
' Procedure : BuildDelConfirmBarcode()
' DateTime  : 6/28/2004
' Modified  : 10/3/2005 Changed to only pass first 5 chars of ZIP
' Purpose   : Builds and Returns USPS Delivery Confirmation Barcode.
'---------------------------------------------------------------------------------------
'
Public Function BuildDelConfirmBarcode(ByVal strDUNS As String) As String
 
    On Error GoTo EH
  
    Dim str420  As String
    Dim strCurrent As String
    Dim str91 As String
    
    str420 = "420" & g_str17
    If g_strClass = "F" Then
        str91 = "9101" & strDUNS
    '07/17/06 Added for No Del Confirm
    ElseIf g_strClass = "A" And g_blnNoDelConfirm Then
        str91 = "9156" & strDUNS
    Else
        str91 = "9102" & strDUNS
    End If
    strCurrent = GetNextUSPSTrkNum
    
    ' add check digit
    str91 = USPSTrkNumCheckDigit(str91 & strCurrent)
    
    ' assemble barcode
    BuildDelConfirmBarcode = str420 & str91
        
    Exit Function

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:BuildDelConfirmBarcode"

End Function
'---------------------------------------------------------------------------------------
' Procedure : USPSTrkNumCheckDigit()
' DateTime  : 6/28/2004
' Modified  : 3/9/2005
' Author    : Keith Thomas
' Purpose   : Calculates MOD10 check digit and returns USPS trk# data.
'---------------------------------------------------------------------------------------
'
Public Function USPSTrkNumCheckDigit(ByVal strData As String)

    On Error GoTo EH

    Dim intLength As Integer
    Dim intStart_Position As Integer
    Dim intValue As Integer
    Dim intTotal_Odd As Integer
    Dim intTotal_Even As Integer
    Dim dblMod_Value As Double
    Dim strCheck_Digit As String
    
    intLength = Len(strData)
  
    intStart_Position = 1

    ' Loop Through And Add All Odd Positon Numbers In strDATA And Multiply By 3
    Do While (intStart_Position <= intLength)
    
        intValue = CInt(Mid(strData, intStart_Position, 1)) * 3
        
        ' Sum Of All Odd Postion Numbers In The Tracking Number
        intTotal_Odd = intTotal_Odd + intValue
    
        ' Move To The Next Odd Number
        intStart_Position = intStart_Position + 2
    
    Loop
 
    ' Reset Start Position Variable To Get The Sum Of Even Position Numbers
    intStart_Position = 2
   
    ' Loop Through And Add All Even Position Numbers In strDATA
    Do While (intStart_Position <= intLength)
    
        intTotal_Even = intTotal_Even + CInt(Mid(strData, intStart_Position, 1))
        
        ' Move To The Next Even Number
        intStart_Position = intStart_Position + 2

    Loop


    ' Get Check Digit, Build Trk# data
    dblMod_Value = (intTotal_Odd + intTotal_Even) Mod 10

    ' Check for zero value
    If (dblMod_Value = 0#) Then
     
        strData = strData + "0"
   
    ElseIf (dblMod_Value > 0#) Then
    
        strCheck_Digit = CStr(10 - dblMod_Value)
        strData = Trim(strData) + Trim(strCheck_Digit)
  
    End If

    ' Return Trk# data
    USPSTrkNumCheckDigit = strData
    
    Exit Function

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:USPSTrkNumCheckDigit"

End Function
'---------------------------------------------------------------------------------------
' Procedure : BuildSPEPLLabel()
' DateTime  : 3/15/2005
' Purpose   : Builds the Smart Post label buffer. Pass Del Confirm Barcode data
'---------------------------------------------------------------------------------------
'
Public Function BuildSPEPLLabel(ByVal strDCB As String) As String
    
    On Error GoTo EH
    
    Dim strLabel As String          'Holds label buffer
    Dim strUCCEAN128 As String      'Postal barcode
    Dim strCityStZip As String      'Concatenate City, St Zip
    Dim strLblLength As String      'Label length
    Dim strOrientation As String    'Label Orientation
      
    'Set the label length command
    Select Case g_str187
        Case "199"                  '6 3/4" doc-tab label
            strLblLength = "Q1370, 24"
        Case "299"                  '6" non-doc-tab label
            strLblLength = "Q1218, 24"
        Case "399"                  '8" non-doc-tab label **does not yet exist!
            strLblLength = "Q1624, 24"
        Case "499"                  '8 3/4" doc-tab label **does not yet exist!
            strLblLength = "Q1776, 24"
    End Select
    
    'Set the label orientation command
    strOrientation = IIf(g_str1370 = "3", "ZB", "ZT")
    
   ' Formating Commands
    strLabel = "OD" & vbCrLf                    'Direct thermal mode
    strLabel = strLabel & "q812" & vbCrLf       'Width of label (4 X 203DPI)
    strLabel = strLabel & strLblLength & vbCrLf  'Length of label (6 3/4" doc-tab) and gap between labels
    strLabel = strLabel & "N" & vbCrLf          'Clear label buffer
    strLabel = strLabel & "D15" & vbCrLf        'Density - 15 = darkest print
    strLabel = strLabel & strOrientation & vbCrLf         'Print direction - bottom first

    ' Printing Commands
    '***********************************************************************
    ' Return To Header
    'Reduce font size of Company, Addr1, Addr2 if they're Len > 28 and updated
    '       Alt return address variables
    If g_str1586 = "Y" Then
        strLabel = strLabel & "A30,30,0,4,1,1,N," & Chr(34) & "Return Address:" & Chr(34) & vbCrLf
        'Alt Return Company
        If Len(g_str1486) > 28 Then
            strLabel = strLabel & "A50,70,0,3,1,1,N," & Chr(34) & g_str1486 & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A50,70,0,4,1,1,N," & Chr(34) & g_str1486 & Chr(34) & vbCrLf
        End If
        'Alt Return Address 1
        If Len(g_str1487) > 28 Then
            strLabel = strLabel & "A50,110,0,3,1,1,N," & Chr(34) & g_str1487 & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A50,110,0,4,1,1,N," & Chr(34) & g_str1487 & Chr(34) & vbCrLf
        End If
        'Alt Return Address 2
        If Len(g_str1488) > 28 Then
            strLabel = strLabel & "A50,150,0,3,1,1,N," & Chr(34) & g_str1488 & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A50,150,0,4,1,1,N," & Chr(34) & g_str1488 & Chr(34) & vbCrLf
        End If
        'Concatenate Alt Return City, St ZIP
        strCityStZip = g_str1489 & ", " & g_str1490 & " " & g_str1491
        'Alt Return City, State, Zip
        strLabel = strLabel & "A50,190,0,4,1,1,N," & Chr(34) & strCityStZip & Chr(34) & vbCrLf
    Else
        strLabel = strLabel & "A30,30,0,4,1,1,N," & Chr(34) & "Return Address:" & Chr(34) & vbCrLf
        ' Return Company
        If Len(g_str4) > 28 Then
            strLabel = strLabel & "A50,70,0,3,1,1,N," & Chr(34) & g_str4 & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A50,70,0,4,1,1,N," & Chr(34) & g_str4 & Chr(34) & vbCrLf
        End If
        ' Return Address 1
        If Len(g_str5) > 28 Then
            strLabel = strLabel & "A50,110,0,3,1,1,N," & Chr(34) & g_str5 & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A50,110,0,4,1,1,N," & Chr(34) & g_str5 & Chr(34) & vbCrLf
        End If
        ' Return Address 2
        If Len(g_str6) > 28 Then
            strLabel = strLabel & "A50,150,0,3,1,1,N," & Chr(34) & g_str6 & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A50,150,0,4,1,1,N," & Chr(34) & g_str6 & Chr(34) & vbCrLf
        End If
        'Concatenate Return City, St ZIP
        strCityStZip = g_str7 & ", " & g_str8 & " " & g_str9
        ' Return City, State, Zip
        strLabel = strLabel & "A50,190,0,4,1,1,N," & Chr(34) & strCityStZip & Chr(34) & vbCrLf
    End If
    '***********************************************************************
    ' Postal Permit Box
    strLabel = strLabel & "X510,30,2,780,150" & vbCrLf
    'Std B - Parcel Post
    If g_strClass = "B" And g_strSubClass = "P" And Val(g_str1670) >= 1 Then
        ' USPS Service Type
        strLabel = strLabel & "A570,40,0,2,1,1,N," & Chr(34) & "PARCEL SELECT" & Chr(34) & vbCrLf
        ' Postage Paid Header
        strLabel = strLabel & "A540,65,0,3,1,1,N," & Chr(34) & "US POSTAGE PAID" & Chr(34) & vbCrLf
        ' USPS Account Number
        strLabel = strLabel & "A580,90,0,3,1,1,N," & Chr(34) & "SmartPost" & Chr(34) & vbCrLf
        ' E-VS
        strLabel = strLabel & "A615,115,0,3,1,1,N," & Chr(34) & "e-VS" & Chr(34) & vbCrLf
    'Std B - Bound Printed Matter
    ElseIf g_strClass = "B" And g_strSubClass = "B" Then
        ' USPS Service Type
        strLabel = strLabel & "A590,40,0,2,1,1,N," & Chr(34) & "PRSRT BPM" & Chr(34) & vbCrLf
        ' Postage Paid Header
        strLabel = strLabel & "A540,65,0,3,1,1,N," & Chr(34) & "US POSTAGE PAID" & Chr(34) & vbCrLf
        ' USPS Account Number
        strLabel = strLabel & "A580,90,0,3,1,1,N," & Chr(34) & "SmartPost" & Chr(34) & vbCrLf
        ' E-VS
        strLabel = strLabel & "A615,115,0,3,1,1,N," & Chr(34) & "e-VS" & Chr(34) & vbCrLf
    'Std B - Media Mail
    ElseIf g_strClass = "B" And g_strSubClass = "M" Then
        ' USPS Service Type
        strLabel = strLabel & "A580,40,0,2,1,1,N," & Chr(34) & "MEDIA MAIL" & Chr(34) & vbCrLf
        ' Postage Paid Header
        strLabel = strLabel & "A540,65,0,3,1,1,N," & Chr(34) & "US POSTAGE PAID" & Chr(34) & vbCrLf
        ' USPS Account Number
        strLabel = strLabel & "A580,90,0,3,1,1,N," & Chr(34) & "SmartPost" & Chr(34) & vbCrLf
        ' E-VS
        strLabel = strLabel & "A615,115,0,3,1,1,N," & Chr(34) & "e-VS" & Chr(34) & vbCrLf
    'Std A
    ElseIf g_strClass = "A" Or (g_strClass = "B" And Val(g_str1670) < 1) Then
        ' USPS Service Type
        strLabel = strLabel & "A590,40,0,2,1,1,N," & Chr(34) & "PRSRT STD" & Chr(34) & vbCrLf
        ' Postage Paid Header
        If g_blnNoDelConfirm Then
            strLabel = strLabel & "A550,65,0,2,1,1,N," & Chr(34) & "US Postage Paid" & Chr(34) & vbCrLf
        Else
            strLabel = strLabel & "A515,65,0,2,1,1,N," & Chr(34) & "US Postage & Fees Paid" & Chr(34) & vbCrLf
        End If
        ' USPS Account Number
        strLabel = strLabel & "A580,90,0,3,1,1,N," & Chr(34) & "SmartPost" & Chr(34) & vbCrLf
        ' E-VS
        strLabel = strLabel & "A615,115,0,3,1,1,N," & Chr(34) & "e-VS" & Chr(34) & vbCrLf
    'Priority Mail
    ElseIf g_strClass = "F" Then
        ' USPS Service Type
        strLabel = strLabel & "A570,40,0,2,1,1,N," & Chr(34) & "PRIORITY MAIL" & Chr(34) & vbCrLf
        ' Postage Paid Header
        strLabel = strLabel & "A540,65,0,3,1,1,N," & Chr(34) & "US POSTAGE PAID" & Chr(34) & vbCrLf
        ' USPS Account Number
        strLabel = strLabel & "A580,90,0,3,1,1,N," & Chr(34) & "SmartPost" & Chr(34) & vbCrLf
    End If
    '***********************************************************************
    ' Horizontal Line 1
    strLabel = strLabel & "LO10,240,790,2" & Chr(10)
    '***********************************************************************
    ' Shipper
    strLabel = strLabel & "A30,265,0,4,1,1,N," & Chr(34) & "Shipper:    SmartPost" & Chr(34) & vbCrLf
    '***********************************************************************
    ' Horizontal Line 2
    strLabel = strLabel & "LO10,315,790,2" & Chr(10)
    '***********************************************************************
    ' 09/18/06 Ancillary Endorsement
    strLabel = strLabel & "A200,335,0,4,1,1,N," & Chr(34) & g_strEndorsement & Chr(34) & vbCrLf
    '***********************************************************************
    ' USPS Deliver To Header
    strLabel = strLabel & "A30,385,0,4,1,1,N," & Chr(34) & "Ship To:" & Chr(34) & vbCrLf
    ' USPS Deliver To Company
    strLabel = strLabel & "A50,425,0,4,1,1,N," & Chr(34) & UCase(Left(g_str11, 35)) & Chr(34) & vbCrLf
    ' USPS Deliver To Contact
    strLabel = strLabel & "A50,465,0,4,1,1,N," & Chr(34) & UCase(Left(g_str12, 35)) & Chr(34) & vbCrLf
    ' USPS Deliver To Address 1
    strLabel = strLabel & "A50,505,0,4,1,1,N," & Chr(34) & UCase(Left(g_str13, 35)) & Chr(34) & vbCrLf
    ' USPS Deliver To Address 2
    strLabel = strLabel & "A50,545,0,4,1,1,N," & Chr(34) & UCase(Left(g_str14, 35)) & Chr(34) & vbCrLf
    'Concatenate USPS Deliver To City, St ZIP
    strCityStZip = g_str15 & ", " & g_str16 & " " & g_str17
    ' USPS Deliver To City, State, Zip
    strLabel = strLabel & "A50,585,0,4,1,1,N," & Chr(34) & UCase(strCityStZip) & Chr(34) & vbCrLf
    '***********************************************************************
    ' Horizontal Line 3
    strLabel = strLabel & "LO10,635,790,4" & Chr(10)
    '***********************************************************************
    ' e-VS Header
    '07/14/06 Added for Std A no del confirm
    If g_strClass = "A" And g_blnNoDelConfirm Then
        strLabel = strLabel & "A288,665,0,1,2,3,N," & Chr(34) & "ZIP - e-VS" & Chr(34) & vbCrLf
    Else
        strLabel = strLabel & "A88,665,0,1,2,3,N," & Chr(34) & "ZIP - USPS DELIVERY CONFIRM e-VS" & Chr(34) & vbCrLf
    End If
 
    'Format postal barcode
    strUCCEAN128 = Chr(34) & Mid(strDCB, 1, 8) & Chr(6) & Mid(strDCB, 9, 22) & Chr(34) & Chr(10)
    ' USPS Tracking Number Barcode
    strLabel = strLabel & "B60,725,0,1E,3,3,160,N," & strUCCEAN128
   
    strLabel = strLabel & "A140,910,0,3,1,2,N," & Chr(34) & _
          Mid(strDCB, 1, 3) & "  " & _
          Mid(strDCB, 4, 5) & "  " & _
          Mid(strDCB, 9, 4) & " " & _
          Mid(strDCB, 13, 4) & " " & _
          Mid(strDCB, 17, 4) & " " & _
          Mid(strDCB, 21, 4) & " " & _
          Mid(strDCB, 25, 4) & " " & _
          Mid(strDCB, 29, 4) & " " & _
          Chr(34) & vbCrLf   ' USPS Tracking Number Readable
    
    '***********************************************************************
    ' Horizontal Line 4
    strLabel = strLabel & "LO10,960,790,4" & Chr(10)
    '***********************************************************************
    ' Reference barcode To Header
    If g_str25 <> "" Then
        strLabel = strLabel & "A30,990,0,3,1,1,N," & Chr(34) & "Customer Reference Barcode:" & Chr(34) & vbCrLf
        
        ' Reference Barcode with Human Readable
        strLabel = strLabel & "B60,1030,0,1,3,3,120,B," & Chr(34) & g_str25 & Chr(34) & vbCrLf
    End If
    
    '20070620-02 Added call to function hook allowing custom SP labels
    strLabel = BuildCustomSPLabel(strLabel)
    
    ' Print label code
    strLabel = strLabel & "P1" & vbCrLf

    strLabel = strLabel & "N" & vbCrLf
    
    BuildSPEPLLabel = strLabel
    
    Exit Function

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:BuildSPEPLLabel"

End Function
'---------------------------------------------------------------------------------------
' Procedure : BuildSPZPLLabel()
' DateTime  : 20070619-01
' Purpose   : Builds the Smart Post ZPL label buffer. Pass Del Confirm Barcode data
'---------------------------------------------------------------------------------------
'
Public Function BuildSPZPLLabel(ByVal strDCB As String) As String
    
    On Error GoTo EH
    
    Dim strLabel As String          'Holds label buffer
    Dim strCityStZip As String      'Concatenate City, St Zip
    Dim strOrientation As String    'Label Orientation

    
    'Set the label orientation command - N Top first, I bottom first
    strOrientation = IIf(g_str1370 = "3", "N", "I")
    
   ' Formating Commands
    'strLabel = strLabel & strLblLength & vbCrLf  'Length of label (6 3/4" doc-tab) and gap between labels
    strLabel = "^XA^CF,0,0,0^PR12^MD30^PW800^PO" & strOrientation & Chr(10)
    
    '***********************************************************************
    'Alt Return Address or Shipper Address
    If g_str1586 = "Y" Then
        strLabel = strLabel & "^FO30,30^A0N,25,32^FWN^FH^FDReturn Address:^FS" & Chr(10)
        'Alt Return Company
        strLabel = strLabel & "^FO50,70^A0N,25,32^FWN^FH^FD" & g_str1486 & "^FS" & Chr(10)
        'Alt Return Address 1
        strLabel = strLabel & "^FO50,110^A0N,25,32^FWN^FH^FD" & g_str1487 & "^FS" & Chr(10)
        'Alt Return Address 2
        strLabel = strLabel & "^FO50,150^A0N,25,32^FWN^FH^FD" & g_str1488 & "^FS" & Chr(10)
        'Concatenate Alt Return City, St ZIP
        strCityStZip = g_str1489 & ", " & g_str1490 & " " & g_str1491
        'Alt Return City, State, Zip
        strLabel = strLabel & "^FO50,190^A0N,25,32^FWN^FH^FD" & strCityStZip & "^FS" & Chr(10)
    Else
        strLabel = strLabel & "^FO30,30^A0N,25,32^FWN^FH^FDReturn Address:^FS" & Chr(10)
        ' Return Company
        strLabel = strLabel & "^FO50,70^A0N,25,32^FWN^FH^FD" & g_str4 & "^FS" & Chr(10)
        ' Return Address 1
        strLabel = strLabel & "^FO50,110^A0N,25,32^FWN^FH^FD" & g_str5 & "^FS" & Chr(10)
        ' Return Address 2
        strLabel = strLabel & "^FO50,150^A0N,25,32^FWN^FH^FD" & g_str6 & "^FS" & Chr(10)
        'Concatenate Return City, St ZIP
        strCityStZip = g_str7 & ", " & g_str8 & " " & g_str9
        ' Return City, State, Zip
        strLabel = strLabel & "^FO50,190^A0N,25,32^FWN^FH^FD" & strCityStZip & "^FS" & Chr(10)
    End If
    '***********************************************************************
    ' Postal Permit Box
    strLabel = strLabel & "^FO455,23^GB322,2,2^FS" & Chr(10)
    strLabel = strLabel & "^FO455,23^GB2,125,2^FS" & Chr(10)
    strLabel = strLabel & "^FO777,25^GB2,125,2^FS" & Chr(10)
    strLabel = strLabel & "^FO455,148^GB324,2,2^FS" & Chr(10)
    'Std B - Parcel Post
    If g_strClass = "B" And g_strSubClass = "P" And Val(g_str1670) >= 1 Then
        ' USPS Service Type
        strLabel = strLabel & "^FO535,46^AdN,0,0^FWN^FH^FDPARCEL SELECT^FS" & Chr(10)
        ' Postage Paid Header
        strLabel = strLabel & "^FO515,71^AdN,0,0^FWN^FH^FDUS POSTAGE PAID^FS" & Chr(10)
        ' USPS Account Number
        strLabel = strLabel & "^FO560,96^AdN,0,0^FWN^FH^FDSmartPost^FS" & Chr(10)
        ' E-VS
        strLabel = strLabel & "^FO585,121^AdN,0,0^FWN^FH^FDe-VS^FS" & Chr(10)
    'Std B - Bound Printed Matter
    ElseIf g_strClass = "B" And g_strSubClass = "B" Then
        ' USPS Service Type
        strLabel = strLabel & "^FO555,46^AdN,0,0^FWN^FH^FDPRSRT BPM^FS" & Chr(10)
        ' Postage Paid Header
        strLabel = strLabel & "^FO515,71^AdN,0,0^FWN^FH^FDUS POSTAGE PAID^FS" & Chr(10)
        ' USPS Account Number
        strLabel = strLabel & "^FO560,96^AdN,0,0^FWN^FH^FDSmartPost^FS" & Chr(10)
        ' E-VS
        strLabel = strLabel & "^FO585,121^AdN,0,0^FWN^FH^FDe-VS^FS" & Chr(10)
    'Std B - Media Mail
    ElseIf g_strClass = "B" And g_strSubClass = "M" Then
        ' USPS Service Type
        strLabel = strLabel & "^FO545,46^AdN,0,0^FWN^FH^FDMEDIA MAIL^FS" & Chr(10)
        ' Postage Paid Header
        strLabel = strLabel & "^FO515,71^AdN,0,0^FWN^FH^FDUS POSTAGE PAID^FS" & Chr(10)
        ' USPS Account Number
        strLabel = strLabel & "^FO560,96^AdN,0,0^FWN^FH^FDSmartPost^FS" & Chr(10)
        ' E-VS
        strLabel = strLabel & "^FO585,121^AdN,0,0^FWN^FH^FDe-VS^FS" & Chr(10)
    'Std A
    ElseIf g_strClass = "A" Or (g_strClass = "B" And Val(g_str1670) < 1) Then
        ' USPS Service Type
        strLabel = strLabel & "^FO560,46^AdN,0,0^FWN^FH^FDPRSRT STD^FS" & Chr(10)
        ' Postage Paid Header
        If g_blnNoDelConfirm Then
            strLabel = strLabel & "^FO525,71^AdN,0,0^FWN^FH^FDUS Postage Paid^FS" & Chr(10)
        Else
            strLabel = strLabel & "^FO490,71^AdN,0,0^FWN^FH^FDUS Postage & Fees Paid^FS" & Chr(10)
        End If
        ' USPS Account Number
        strLabel = strLabel & "^FO560,96^AdN,0,0^FWN^FH^FDSmartPost^FS" & Chr(10)
        ' E-VS
        strLabel = strLabel & "^FO585,121^AdN,0,0^FWN^FH^FDe-VS^FS" & Chr(10)
    'Priority Mail
    ElseIf g_strClass = "F" Then
        ' USPS Service Type
        strLabel = strLabel & "^FO535,46^AdN,0,0^FWN^FH^FDPRIORITY MAIL^FS" & Chr(10)
        ' Postage Paid Header
        strLabel = strLabel & "^FO515,71^AdN,0,0^FWN^FH^FDUS POSTAGE PAID^FS" & Chr(10)
        ' USPS Account Number
        strLabel = strLabel & "^FO560,96^AdN,0,0^FWN^FH^FDSmartPost^FS" & Chr(10)
    End If
    
    '***********************************************************************
    ' Horizontal Line 1
    strLabel = strLabel & "^FO10,240^GB790,2,2^FS" & Chr(10)
    
    '***********************************************************************
    ' Shipper
    strLabel = strLabel & "^FO30,265^A0N,25,32^FWN^FH^FDShipper:    SmartPost^FS" & Chr(10)
    
    '***********************************************************************
    ' Horizontal Line 2
    strLabel = strLabel & "^FO10,315^GB790,2,2^FS" & Chr(10)
    
    '***********************************************************************
    'Ancillary Endorsement
    strLabel = strLabel & "^FO200,335^A0N,25,32^FWN^FH^FD" & g_strEndorsement & "^FS" & Chr(10)
   
    '***********************************************************************
    ' USPS Deliver To Header
    strLabel = strLabel & "^FO30,385^A0N,25,32^FWN^FH^FDShip To:^FS" & Chr(10)
    ' USPS Deliver To Company
    strLabel = strLabel & "^FO50,425^A0N,25,32^FWN^FH^FD" & UCase(Left(g_str11, 35)) & "^FS" & Chr(10)
    ' USPS Deliver To Contact
    strLabel = strLabel & "^FO50,465^A0N,25,32^FWN^FH^FD" & UCase(Left(g_str12, 35)) & "^FS" & Chr(10)
    ' USPS Deliver To Address 1
    strLabel = strLabel & "^FO50,505^A0N,25,32^FWN^FH^FD" & UCase(Left(g_str13, 35)) & "^FS" & Chr(10)
    ' USPS Deliver To Address 2
    strLabel = strLabel & "^FO50,545^A0N,25,32^FWN^FH^FD" & UCase(Left(g_str14, 35)) & "^FS" & Chr(10)
    'strLabel = strLabel & "^FO43,418^A0N,25,27^FWN^FH^FD^FS" & Chr(10)
    'Concatenate USPS Deliver To City, St ZIP
    strCityStZip = g_str15 & ", " & g_str16 & " " & g_str17
    ' USPS Deliver To City, State, Zip
    strLabel = strLabel & "^FO50,585^A0N,25,32^FWN^FH^FD" & UCase(strCityStZip) & "^FS" & Chr(10)
    
    '***********************************************************************
    ' Horizontal Line 3
    strLabel = strLabel & "^FO10,635^GB790,2,2^FS" & Chr(10)
    '***********************************************************************
    ' e-VS Header
    'Std A no del confirm
    If g_strClass = "A" And g_blnNoDelConfirm Then
        strLabel = strLabel & "^FO288,665^A0N,40,40^FWN^FH^FDZIP - e-VS^FS" & Chr(10)
    Else
        strLabel = strLabel & "^FO88,665^A0N,40,40^FWN^FH^FDZIP - USPS DELIVERY CONFIRM e-VS^FS" & Chr(10)
    End If
 
    ' USPS Tracking Number Barcode
    strLabel = strLabel & "^FO60,725^BY3,2^BCN,160,N,N,N,N^FWN^FD>;>8" & Mid(strDCB, 1, 8) & ">8" & Mid(strDCB, 9, 22) & "^FS" & Chr(10)
   
    strLabel = strLabel & "^FO140,910^A0N,35,30^FWN^FH^FD" & _
          Mid(strDCB, 1, 3) & "  " & _
          Mid(strDCB, 4, 5) & "  " & _
          Mid(strDCB, 9, 4) & " " & _
          Mid(strDCB, 13, 4) & " " & _
          Mid(strDCB, 17, 4) & " " & _
          Mid(strDCB, 21, 4) & " " & _
          Mid(strDCB, 25, 4) & " " & _
          Mid(strDCB, 29, 4) & " " & _
          "^FS" & Chr(10)   ' USPS Tracking Number Readable
    
    '***********************************************************************
    ' Horizontal Line 4
    strLabel = strLabel & "^FO10,960^GB790,2,2^FS" & Chr(10)
    'Reference barcode
    If g_str25 <> "" Then
        strLabel = strLabel & "^FO30,990^A0N,25,30^FWN^FH^FDCustomer Reference Barcode:^FS" & Chr(10)
        
        ' Reference Barcode with Human Readable
        strLabel = strLabel & "^FO60,1030^BY3,2^A0N,24,28^BCN,120,Y,N,N,N^FWN^FD" & g_str25 & "^FS" & Chr(10)
    End If
    
    '20070620-03 Added call to function hook allowing custom SP labels
    strLabel = BuildCustomSPLabel(strLabel)
    
    strLabel = strLabel & "^PQ1" & Chr(10)
    strLabel = strLabel & "^XZ" & Chr(10) & Chr(12)

    BuildSPZPLLabel = strLabel
    
    Exit Function

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:BuildSPZPLLabel"

End Function
'---------------------------------------------------------------------------------------
' Procedure : SPDIMsCheck()
' DateTime  : 3/8/2005
' Purpose   : Calculates if 2H + 2W + L for Smart Post and SP+.
'             Returns an INT
'---------------------------------------------------------------------------------------
'
Public Function SPDIMsCheck(ByVal H As String, ByVal W As String, ByVal L As String) As Integer
    
    '20070718-02 Added to return 0 if invalid DIM passed
    If Not IsNumeric(H) Or Not IsNumeric(W) Or Not IsNumeric(L) Then
        SPDIMsCheck = -1
    ElseIf Val(H) < 1 Or Val(W) < 1 Or Val(L) < 1 Then
        SPDIMsCheck = 0
    Else
        SPDIMsCheck = (Val(H) * 2) + (Val(W) * 2) + Val(L)
    End If

End Function
'20070327-11 Removed PrintSPLabel
'---------------------------------------------------------------------------------------
' Procedure : PrintSmartPostLabel()
' DateTime  : 3/15/2005
' Purpose   : Prints Smart Post label.
'---------------------------------------------------------------------------------------
'
Public Sub PrintSmartPostLabel()
 
    On Error GoTo EH
  
    Dim FSO As New FileSystemObject
    Dim TSO As TextStream
    Dim strFileSpec As String
        
    'Create Label Folder if it doesn't exist
    If Not FSO.FolderExists(App.Path & "\Labels") Then
        FSO.CreateFolder App.Path & "\Labels"
    End If
    
    'Build Delivery Confirmation Barcode
    g_strDCB = BuildDelConfirmBarcode(g_strSPDUNS)
    
    'Create Filespec
    strFileSpec = App.Path & "\Labels\" & g_strDCB & ".txt"
    
    'Build first label and copy to printer UNC
    Set TSO = FSO.CreateTextFile(strFileSpec, True)
    
    '20070620-05 Added code to handle ZPL labels
    If g_str187 = "188" Or g_str187 = "288" Then
        TSO.Write BuildSPZPLLabel(g_strDCB)
    Else
        TSO.Write BuildSPEPLLabel(g_strDCB)
    End If
    
    TSO.Close
    
    '20071101-01 Added code to print to g_strUNCCustomLabels when Custom Labels selected for Ex/Gr
    If frmSetup.chkCustomLabels = 1 And g_strUNCCustomLabels <> "" Then
        FSO.CopyFile strFileSpec, g_strUNCCustomLabels
    ElseIf g_str537 <> "" Then
        FSO.CopyFile strFileSpec, g_str537
    End If
    
Release:
    Set TSO = Nothing
    Set FSO = Nothing
    
    Exit Sub

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:PrintSmartPostLabel"
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : GetNextUSPSTrkNum()
' DateTime  : 20070727-01
' Purpose   : New function to return and increment SP trk#s. Uses new table SPtrkNum.
'---------------------------------------------------------------------------------------
'
Public Function GetNextUSPSTrkNum() As String

    On Error GoTo EH

    Dim strQuery As String
    Dim rsTrkNum As New ADODB.Recordset
    Dim strFakeVal As String
    
    strFakeVal = GetSystemName & Format(Now, "HHMMSS")
    
    strQuery = "INSERT INTO SPTrkNum (FakeVal) VALUES('" & strFakeVal & "')"
    g_connFSMSClient.Execute strQuery
    
    strQuery = "SELECT USPSCurrentTrkNum FROM SPTrkNum WHERE FakeVal = '" & strFakeVal & "'"
    rsTrkNum.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    GetNextUSPSTrkNum = Format(rsTrkNum(0), "00000000")
    
    strQuery = "DELETE FROM SPTrkNum WHERE FakeVal = '" & strFakeVal & "'"
    g_connFSMSClient.Execute strQuery

Release:
    
    If rsTrkNum.State = adStateOpen Then rsTrkNum.Close
    Set rsTrkNum = Nothing
    
    Exit Function
EH:

    'This err.number is returned of the mdb is locked. Re-try query and resume.
    If Err.number = -2147467259 Then
        g_connFSMSClient.Execute strQuery
        Resume
    Else
        MsgBox Err.Description, vbCritical, "modSmartPost:GetSPTrkNum"
        Resume Release
    End If

End Function

'200703027-13 Removed GetUSPSLocation

'---------------------------------------------------------------------------------------
' Procedure : ShipSmartPost()
' DateTime  : 4/6/2005
' Purpose   : Calls the routines to print the SP label, to save shipping info, etc.
'             Calls a routine to check business rules first.
'---------------------------------------------------------------------------------------
'
Public Sub ShipSmartPost()
 
    On Error GoTo EH
  
    Dim strErrors As String
    Dim strQuery As String
    Dim rsMPS As New ADODB.Recordset
    
    strQuery = "SELECT * FROM MPS WHERE f1 = " & SingleQuotes(g_str1)
    strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"
    strQuery = strQuery & " order by ShipDate"

    rsMPS.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    'Single piece shipment
    If rsMPS.EOF Then
        strErrors = BusinessRulesCheck(False)
        If strErrors = "" Then
            Call RateSP(g_str17, g_str1670, g_strClass)
            Call PrintSmartPostLabel
            Call SaveSPShipment(Mid(g_strDCB, 11))
            
            If frmShip.chkEmailAlert = 1 And g_str1202 <> "" Then
                Call BuildEmail(g_str29)
            End If
            Call WriteReply
            If g_blnDeletesComplete Then
                Call frmShip.ClearShipFields
                Call ClearGlobalVars
                Call ClearSPGlobalVars
                With frmShip
                    Call .EnableButtons
                    .StatusBar1.Panels(2) = "Shipment Complete!"
                End With
            End If
        Else
            MsgBox "The following error(s) occurred:" & vbCrLf & strErrors, vbExclamation, "SmartPost Errors"
            With frmShip
                Call .EnableButtons
                .StatusBar1.Panels(2) = "Shipment Error"
            End With
        End If
    'MPS
    Else
        strErrors = BusinessRulesCheck(True)
        If strErrors = "" Then
            Do Until rsMPS.EOF
                g_str1670 = rsMPS!g_str1670
                g_str57 = rsMPS!g_str57
                g_str58 = rsMPS!g_str58
                g_str59 = rsMPS!g_str59
                g_str25 = rsMPS!g_str25
                g_str3056 = rsMPS!g_str3056
                Call RateSP(g_str17, g_str1670, g_strClass)
                Call PrintSmartPostLabel
                Call SaveSPShipment(Mid(g_strDCB, 11))
                Call WriteReply
            
                rsMPS.MoveNext
            Loop
            Call DeleteMPS(g_str1)
            If frmMPS.chkPrintAsAdd = 0 Then
                Call frmShip.ClearShipFields
                Call ClearGlobalVars
                Call ClearSPGlobalVars
            End If
            With frmShip
                Call .EnableButtons
                .StatusBar1.Panels(2) = "Shipment Complete!"
            End With
        Else
            MsgBox "The following error(s) occurred:" & vbCrLf & strErrors
            With frmShip
                Call .EnableButtons
                .StatusBar1.Panels(2) = "Shipment Error"
            End With
        End If
    End If

Release:
    If rsMPS.State = adStateOpen Then rsMPS.Close
    Set rsMPS = Nothing
    
    Exit Sub

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:ShipSmartPost"
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Procedure : ShipSmartPostBatch()
' DateTime  : 4/14/2005
' Purpose   : Calls the routines to print the SP label, to save shipping info, etc.
'             Calls a routine to check business rules first. Used for Batch processing.
'---------------------------------------------------------------------------------------
'
Private Sub ShipSmartPostBatch()
        
    On Error GoTo EH
  
    g_str3 = BusinessRulesCheck(False)
    
    If g_str3 = "" Then
        Call RateSP(g_str17, g_str1670, g_strClass)
        Call PrintSmartPostLabel
        g_str29 = Mid(g_strDCB, 11)
        Call SaveSPShipment(g_str29)
        Call WriteSPBatchReply
        
        If g_str1202 <> "" Then
            Call BuildEmail(g_str29)
        End If
        
        Call AfterBatchShip
        Call ClearGlobalVars
        Call ClearSPGlobalVars
    Else
        Call WriteSPBatchError
    End If

    'Call Pause(0.3)
    
    Exit Sub

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:ShipSmartPost"

End Sub
'20070327-06 Removed ShipSPPlus
'---------------------------------------------------------------------------------------
' Module    : SaveSPShipment
' DateTime  : 3/14/2005
' Author    : Chris Elwell
' Purpose   : Store shipment fields to SmartPost table for both SmartPost and SP +
' Call from : g_clsParser_ParseComplete()
'---------------------------------------------------------------------------------------
'
Public Sub SaveSPShipment(ByVal strTrkNum As String)
    
    On Error GoTo EH
    
    Dim strInsertQuery As String
    Dim strShipDate As String
    
    '20070509-03 Exit Sub if Trk# is empty
    If strTrkNum = "" Then Exit Sub
    
    'Added to save Std B < 1lb as Std A
    If g_strClass = "B" And Val(g_str1670) < 1 Then g_strClass = "A"
    
    'Added to assign trk# to global
    g_str29 = strTrkNum
    
    'Date conversion
    'If in date format convert to YYYYMMDD format used in database and FXRS
    If IsDate(g_str24) Then strShipDate = Format(g_str24, "YYYYMMDD")
    'If no date passed set to today and convert to YYYYMMDD format
    If g_str24 = "" Then
        strShipDate = Format(CStr(Date), "YYYYMMDD")
        g_str24 = CStr(Date)
    End If
    
    'Build Insert query
    strInsertQuery = "INSERT INTO SmartPost VALUES("
    strInsertQuery = strInsertQuery + SingleQuotes(strTrkNum) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str1) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str25, 20)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str11, 35)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str12, 35)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str13, 35)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str15, 35)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str16, 14)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(Left(g_str17, 10)) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str50) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str10) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str1274) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(strShipDate) + ","
    strInsertQuery = strInsertQuery + "'Shipped',"
    
    If GetClientDatabaseType = "Access" Then
        strInsertQuery = strInsertQuery + "#" + CStr(Now) + "#, "
    Else
        strInsertQuery = strInsertQuery + "'" + CStr(Now) + "', "
    End If

    strInsertQuery = strInsertQuery + SingleQuotes(g_strDCB) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str11USPS) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str13USPS) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str15USPS) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str16USPS) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str17USPS) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str1670) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_strClass) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_strSubClass) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str3056) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(IIf(g_blnNoDelConfirm, "  ", "01")) + ","
    strInsertQuery = strInsertQuery + SingleQuotes("O") + ","
    '20070726-01 Added Dim fields for new manifest layout
    strInsertQuery = strInsertQuery + SingleQuotes(g_str59) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str58) + ","
    strInsertQuery = strInsertQuery + SingleQuotes(g_str57) + ")"
    g_connFSMSClient.Execute strInsertQuery

    Exit Sub

EH:
    If Err.number = -2147467259 Then
        g_connFSMSClient.Execute strInsertQuery
    Else
        MsgBox Err.Description & " " & Str(Err.number), vbCritical, "modSmartPost:SaveSPShipment"
    End If

End Sub
'---------------------------------------------------------------------------------------
' Module    : ClearSPGlobalVars
' DateTime  : 3/14/2005
' Author    : Chris Elwell
' Purpose   : Clear SmartPost Plus globals
'---------------------------------------------------------------------------------------
'
Public Sub ClearSPGlobalVars()

    g_strDCB = ""                 'Delivery Confirmation Barcode
    g_str11USPS = ""              'USPS Company name
    g_str13USPS = ""              'USPS Addr 1
    g_str15USPS = ""              'USPS City
    g_str16USPS = ""              'USPS State
    g_str17USPS = ""              'USPS Zip
    g_str17USPSActual = ""        'USPS Deliver-To Zip
    g_strClass = ""               'Postal Class
    g_strSubClass = ""            'Postal Sub-class
    g_strEndorsement = ""         'Ancillary Endorsement
    g_strZone = ""                'SP Zone

End Sub
'---------------------------------------------------------------------------------------
' Module    : BuildFTPFile
' DateTime  : 4/5/2005
' Author    : Chris Elwell
' Purpose   : Build the manifest FTP file, returns True if there are shipments
'---------------------------------------------------------------------------------------
'
Public Function BuildFTPFile() As String
    
    On Error GoTo EH
    
    Dim FSO As New FileSystemObject
    Dim TSO As TextStream
    Dim strFilename As String
    Dim strQuery As String
    Dim rsSP As New ADODB.Recordset
    Dim rsSPSetup As New ADODB.Recordset
    Dim strManifestID As String
    Dim strManifestPath As String
    
    'Path to manifests
    strManifestPath = App.Path & "\Manifests"
    
    'Query to get only today's shipped SP pkgs fields required in Detail records
    strQuery = "SELECT  * FROM SmartPost"
    strQuery = strQuery + " WHERE g_str1274 = '99' And Status = 'Shipped' And g_str24 <= "
    strQuery = strQuery + SingleQuotes(Format(Date, "YYYYMMDD")) + " And ManifestStatus = 'O'"
    
    rsSP.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    If Not rsSP.EOF Then
        'Query to get setup fields
        strQuery = "SELECT * FROM SPSetup"
        rsSPSetup.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
        
        '09/15/06  Removed cycle count - Set Manifest ID = CustID + LocID
        strManifestID = Left(rsSPSetup!CustID, 3) + rsSPSetup!CustLocID + rsSPSetup!CurrentSeqID
        
        'Create Manifests Folder if it doesn't exist
        If Not FSO.FolderExists(App.Path & "\Manifests") Then
            FSO.CreateFolder strManifestPath
        End If
        
        'Set filename to Customer ID + Cycle Count + ".MAN"
        strFilename = strManifestPath & "\" + strManifestID + ".MAN"
        
        'Create FTP file, add header, add detail record
        Set TSO = FSO.CreateTextFile(strFilename, True)
        
        'Build Header record passing # of shipments, Customer ID, Manifest ID, and Dist Center
        '20071114-01 Added Trim statement
        TSO.WriteLine BuildFTPHeader(Trim(Str(rsSP.RecordCount)), rsSPSetup!CustID, strManifestID, rsSPSetup!CustLocID, _
                                    rsSPSetup!ManifestGroup, Right(rsSPSetup!DistCenter, 4))
        
        'Build Details records passing DCB, dest ZIP, Class, Sub-class, & refs
        '20070726-01 Added Dim fields for new manifest layout
        Do Until rsSP.EOF
            TSO.WriteLine BuildFTPDetail(rsSP!g_str29, rsSP!g_str1670, rsSP!g_str17, rsSP!Class, _
                                        rsSP!SubClass, rsSP!g_str25, rsSP!g_str3056, rsSP!DelConfirm, _
                                        rsSP!str59, rsSP!str58, rsSP!str57)
            Call SetPkgManifestStatus(rsSP!g_str29)
            
            rsSP.MoveNext
        Loop
        
        TSO.Close
        'Increment the Sequence ID (cycle count) in the SPSetup table
        Call IncrementCycleCount(rsSPSetup!CurrentSeqID)
        'Return the filename
        BuildFTPFile = strFilename
    Else
        BuildFTPFile = ""
    End If

Release:
    If rsSP.State = adStateOpen Then rsSP.Close
    If rsSPSetup.State = adStateOpen Then rsSPSetup.Close
    Set rsSP = Nothing
    Set rsSPSetup = Nothing
    Set FSO = Nothing
    Set TSO = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:BuildFTPFile"
    BuildFTPFile = "FILEERROR"
    Resume Release
    
End Function
'---------------------------------------------------------------------------------------
' Module    : BuildFTPHeader
' DateTime  : 20070726-01 Update to new SP 1.60 manifest specs
' Author    : Chris Elwell
' Purpose   : Builds and returns the 512 byte Header record for the Manifest file
'---------------------------------------------------------------------------------------
'
Private Function BuildFTPHeader(ByVal strTotalPkgs As String, ByVal strCustID As String, _
                                ByVal strManifestID As String, ByVal strCustLocID As String, _
                                ByVal strManifestGroup As String, ByVal strHubID As String) As String

    On Error GoTo EH
    
    Dim strHeader As String
    
    'Positions 1 - 24 - Manifest Version + SP CustID + Manifest Name + Tot Pkgs
    strHeader = " 01.60" + strCustID + strManifestID + strTotalPkgs
    
    'Pads Total Pkgs with spaces to = 5 positions
    If Len(strTotalPkgs) < 5 Then
        strHeader = strHeader + Space(5 - Len(strTotalPkgs))
    End If
    
    'Positions 25 - 38 - 2 Spaces + Ship Date/Time
    strHeader = strHeader + Space(2) + Format(Now, "YYYYMMDDHHMM")
    
    'Positions 39 - 79 - 33 Spaces + Manifest Group
    strHeader = strHeader + Space(33) + strManifestGroup
    
    'Pads Mainfest Group with spaces to = 8 positions
    If Len(strManifestGroup) < 8 Then
        strHeader = strHeader + Space(8 - Len(strManifestGroup))
    End If
    
    'Postions 80 - 89 - Customer Location ID + Space + Meter #
    strHeader = strHeader + strCustLocID + Space(8) ' + g_str498
    
    'Pads Meter # with spaces to = 7 positions
'    If Len(g_str498) < 7 Then
'        strHeader = strHeader + Space(7 - Len(g_str498))
'    End If
   
    'Positions 90 - 102 - SP Hub ID + FedEx Acct#
    strHeader = strHeader + strHubID + g_str10
    
    'Positions 103 - 512 - Space fill
    strHeader = strHeader + Space(410)
    BuildFTPHeader = strHeader
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:BuildFTPHeader"

End Function
'---------------------------------------------------------------------------------------
' Module    : BuildFTPDetail
' DateTime  : 20070726-01 Update to new SP 1.60 manifest specs
' Author    : Chris Elwell
' Purpose   : Builds and returns a 512 byte Detail record for the Manifest file
'---------------------------------------------------------------------------------------
'
Private Function BuildFTPDetail(ByVal strPkgID As String, ByVal str1670 As String, ByVal str17 As String, _
                                ByVal strClass As String, ByVal strSubClass As String, ByVal str25 As String, _
                                ByVal str3056 As String, ByVal strDelConfirm As String, Optional ByVal strL As String, _
                                Optional ByVal strW As String, Optional ByVal strH As String) As String

    On Error GoTo EH
    
    Dim strDetail As String
    
    'Postions 1 - 49 - Space + PkgID + 10 Spaces + Weight + Space fill wgt + Space + Dest ZIP + Space fill Dest ZIP
    strDetail = Space(1) + strPkgID + Space(10) + str1670 + Space(5 - Len(str1670)) + Space(1) + str17 + Space(12 - Len(str17))
    
    'Positions 50 - 185 - 10 Spaces + Class + SubClass + 7 Spaces + Del Confirm indicator + 115 spaces
    strDetail = strDetail + Space(10) + strClass + strSubClass + Space(7) + strDelConfirm + Space(115)
    
    'Positions 186 - 411 - Billing Ref # + Space fill Billing Ref # + Pkg Ref + Space fill Pkg Ref + 195 Spaces
    strDetail = strDetail + str3056 + Space(10 - Len(str3056)) + str25 + Space(20 - Len(str25)) + Space(196)

    'Positions 412 - 512 - L Dim + Space fill L Dim + W Dim + Space fill W Dim + H Dim + Space fill H Dim + 77 spaces
    strDetail = strDetail + strL + Space(8 - Len(strL)) + strW + Space(8 - Len(strW)) + strH + Space(8 - Len(strH)) + Space(77)
    
    BuildFTPDetail = strDetail

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:BuildFTPDetail"

End Function
'---------------------------------------------------------------------------------------
' Module    : BusinessRulesCheck
' DateTime  : 4/7/2005
' Author    : Chris Elwell
' Purpose   : Checks for required SP fields
'---------------------------------------------------------------------------------------
'
Private Function BusinessRulesCheck(ByVal blnMPS As Boolean) As String
    
    On Error GoTo EH
    
    Dim strMessages As String
    Dim rsMPS As New ADODB.Recordset
    Dim strQuery As String
    Dim intDIMs As Integer
    
    Dim i As Integer
    
    With frmShip
        If g_str11 = "" And g_str12 = "" Then
            strMessages = "Company or Contact Required" & vbCrLf
        End If
        If g_str13 = "" Then
            strMessages = strMessages + "Address 1 Required" & vbCrLf
        End If
        If g_str15 = "" Then
            strMessages = strMessages + "City Required" & vbCrLf
        End If
        If g_str16 = "" Then
            '20071002-01 Added for SP to PR
            If g_str50 = "PR" Then
                frmShip.f16 = "PR"
                g_str16 = "PR"
            Else
                strMessages = strMessages + "State Required" & vbCrLf
            End If
        End If
        If g_str17 = "" Then
            strMessages = strMessages + "Zip Required" & vbCrLf
        End If
        '20070813-02 Check for Invalid date.
        If Not IsDate(g_str24) Then
            strMessages = strMessages + "Invalid Date Entered" & vbCrLf
        End If
        '02/17/06 Added a numeric check on the Zip
        If (Len(g_str17) > 0 And Len(g_str17) < 5) Or Not IsNumeric(g_str17) Then
            strMessages = strMessages + g_str17 & " is not a valid Zip code." & vbCrLf
        End If
        If Not blnMPS Then
            If Val(g_str1670) = 0 Then
                strMessages = strMessages + "Weight Required" & vbCrLf
            '02/17/06 Added a max weight check
            ElseIf Val(g_str1670) > 70 Then
                strMessages = strMessages + "Maximum SmartPost weight of 70lbs. exceeded." & vbCrLf
            End If
            '02/28/06 Added MAX Std A weight check
            If Val(g_str1670) >= 1 And g_strClass = "A" Then
                strMessages = strMessages + "Maximum Std A Weight Exceeded" & vbCrLf
            End If
            '02/28/06 Added MIN Std B weight check
            If Val(g_str1670) < 1 And g_strClass = "B" And (frmSetup.chkAllowStdA = 1 Or g_strSubClass <> "P") Then
                strMessages = strMessages + "Below Std B Minimum Weight" & vbCrLf
            End If
            '20070718-03 Added code to check for invalid dimensions entered in SP
            intDIMs = SPDIMsCheck(.f57, .f58, .f59)
            If intDIMs > 130 Then
                strMessages = strMessages + "Dimensions exceed maximum allowed Length + Girth of 130" & Chr(34) & vbCrLf
            ElseIf intDIMs = 0 Then
                strMessages = strMessages + "Invalid Dimensions entered" & vbCrLf
            End If
        Else
            strQuery = "SELECT g_str1670 FROM MPS WHERE f1 = " & SingleQuotes(g_str1)
            strQuery = strQuery & " AND Workstation = '" & g_strComputerName & "'"
            strQuery = strQuery & " order by ShipDate"

            rsMPS.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
            i = 1
            Do Until rsMPS.EOF
                If Val(rsMPS!g_str1670 & "") = 0 Then
                    strMessages = strMessages + "Weight Pkg" & Str(i) & " Required" & vbCrLf
                ElseIf Val(rsMPS!g_str1670 & "") > 70 Then
                    '20070327-10 Harcoded Max SP Wgt to 70 lbs
                    strMessages = strMessages + "Pkg" & Str(i) & ": Maximum SmartPost weight of 70 lbs. exceeded." & vbCrLf
                End If
                'MAX Std A weight check
                If Val(rsMPS!g_str1670 & "") >= 1 And g_strClass = "A" Then
                    strMessages = strMessages + "Pkg" & Str(i) & ": Maximum Std A Weight Exceeded" & vbCrLf
                End If
                'Added MIN Std B weight check
                If Val(rsMPS!g_str1670 & "") < 1 And g_strClass = "B" And (frmSetup.chkAllowStdA = 1 Or g_strSubClass <> "P") Then
                    strMessages = strMessages + "Pkg" & Str(i) & ": Below Std B Minimum Weight" & vbCrLf
                End If
                '20070718-03 Added code to check for invalid dimensions entered in SP
                intDIMs = SPDIMsCheck(rsMPS!f57, rsMPS!f58, rsMPS!f59)
                If intDIMs > 130 Then
                    strMessages = strMessages + "Dimensions exceed maximum allowed Length + Girth of 130" & Chr(34) & vbCrLf
                ElseIf intDIMs = 0 Then
                    strMessages = strMessages + "Invalid Dimensions entered" & vbCrLf
                End If
                rsMPS.MoveNext
                i = i + 1
            Loop
        End If
        If g_strClass = "" Then
            strMessages = strMessages + "Postal Class Required" & vbCrLf
        End If
        If g_strSubClass = "" Then
            strMessages = strMessages + "Postal Sub-class Required" & vbCrLf
        End If
    End With
    
    BusinessRulesCheck = strMessages
    
Release:
    If rsMPS.State = adStateOpen Then rsMPS.Close
    Set rsMPS = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:BusinessRulesCheck"
    Resume Release
    
End Function
'---------------------------------------------------------------------------------------
' Module    : IncrementCycleCount
' DateTime  : 20070730-02 Removed saving LowSeqID, CurrentSeqID, HighSeqID
' Author    : Chris Elwell
' Purpose   : Increments the cycle count A.K.A Sequence ID. Resets to low value if at max
'             and writes it to the SPSetup table.
'---------------------------------------------------------------------------------------
'
Private Sub IncrementCycleCount(ByVal strCurrent As String)
    
    On Error GoTo EH
    
    Dim strQuery As String
    
    'If current Cycle Count 999 reset to 000
    If strCurrent = "999" Then
        strQuery = "UPDATE SPSetup SET [CurrentSeqID] = '000'"
    Else
        strQuery = "UPDATE SPSetup SET [CurrentSeqID] = " & SingleQuotes(Format(Val(strCurrent) + 1, "000"))
    End If
    
    g_connFSMSClient.Execute strQuery
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:IncrementCycleCount"
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : GetFTPPath
' DateTime  : 20070731-02 Modifed Select Case and added Sacramento
' Author    : Chris Elwell
' Purpose   : Returns the path for the SmartPost FTP file based on the Dist Center
'---------------------------------------------------------------------------------------
'
Public Function GetFTPPath() As String

    On Error GoTo EH
    
    Dim strPath As String

    strPath = "/SMARTPOST/"
    
    Select Case Left(frmSetup.cboDistCenter, Len(frmSetup.cboDistCenter) - 7)
        Case "Atlanta"
            strPath = strPath & "ATLANTA"
        Case "Belleville"
            strPath = strPath & "BELLEVILLE"
        Case "Dallas"
            strPath = strPath & "DALLAS"
        Case "Denver"
            strPath = strPath & "DENVER"
        Case "Florida"
            strPath = strPath & "FLORIDA"
        Case "Indianapolis"
            strPath = strPath & "INDIANAPOLIS"
        Case "Los Angeles"
            strPath = strPath & "LOSANGELES"
        Case "Massachusetts"
            strPath = strPath & "MASSACHUSETTS"
        Case "Minneapolis"
            strPath = strPath & "MINNEAPOLIS"
        Case "New Berlin"
            strPath = strPath & "NEWBERLIN"
        Case "New Jersey"
            strPath = strPath & "NEWJERSEY"
        Case "North Carolina"
            strPath = strPath & "NORTHCAROLINA"
        Case "Ohio"
            strPath = strPath & "OHIO"
        Case "Philadelphia"
            strPath = strPath & "PHILADELPHIA"
        Case "Phoenix"
            strPath = strPath & "PHOENIX"
        Case "Pittsburgh"
            strPath = strPath & "PITTSBURGH"
        Case "Sacramento"
            strPath = strPath & "SACRAMENTO"
        Case "San Francisco"
            strPath = strPath & "SANFRANCISCO"
        Case "Seattle"
            strPath = strPath & "SEATTLE"
        Case "St. Louis"
            strPath = strPath & "STLOUIS"
        Case "West Virginia"
            strPath = strPath & "WESTVIRGINIA"
    End Select
 
    GetFTPPath = strPath
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:IncrementCycleCount"
    
End Function
'---------------------------------------------------------------------------------------
' Module    : SendFTPFile
' DateTime  : 4/7/2005
' Modified  : 7/25/2006 - Updated to show Inet control errors
' Author    : Chris Elwell
' Purpose   : Send the FTP file(s) to SmartPost FTP site that have the extension ".MAN".
'---------------------------------------------------------------------------------------
'
Public Sub SendFTPFile()
        
    On Error GoTo EH
    
    Dim strPUT As String
    Dim strCD As String
    Dim strFilename As String
    Dim strPath As String
    
    'Set path to manifests
    strPath = App.Path & "\Manifests\"
    'Get first manifest name
    strFilename = Dir(strPath & "*.Man")
    
    'If there are no file show message on Close form and exit
    If strFilename = "" Then
        frmClose.lstCloseStatus.AddItem "No files to transmit"
    Else
        'Build change dir command
        strCD = "CD " & GetFTPPath
        
        'Send commands to FTP site
        With frmClose.Inet1
            .URL = g_strFTPURL
            'Set AccessType if using proxy
            If g_strFTPProxy <> "" Then
                .Proxy = g_strFTPProxy
                .AccessType = icNamedProxy
            Else
                .AccessType = icUseDefault
            End If
            .UserName = g_strFTPUID
            .Password = g_strFTPPWD
            
            'Set upload directory
            .Execute , strCD
            Do
                DoEvents
            Loop While .StillExecuting
            
            '20070822-01 Added to make checkbox Use Passive FTP on frmSetup SmartPost tab. Added code to save/load/use this value.
            If frmSetup.chkUsePassiveFTP = 1 Then
                '20070511-04 set passive mode firewall / proxy  server issues. Thanks to Rich Udell!
                .Execute , "literal pasv"
                Do
                    DoEvents
                Loop While .StillExecuting
            End If
           
            'loop through all untransmitted manifest files and send
            Do While strFilename <> ""
                'Build PUT command
                strPUT = "PUT " & Chr(34) & strPath & strFilename & Chr(34) & " " & strFilename
                .Execute , strPUT
                Do
                    DoEvents
                Loop While .StillExecuting
                'If no error update status and change filename
                If .ResponseCode = 0 Then
                    Call ChangeManifestName(strPath, strFilename)
                    frmClose.lstCloseStatus.AddItem "File Upload Complete!"
                'Else show error message and update status
                Else
                    'Update status message on close form
                    frmClose.lstCloseStatus.AddItem "File Upload Failed!"
                    MsgBox .ResponseInfo, vbCritical, "Manifest Transfer Error"
                End If
                strFilename = Dir()
            Loop
        End With
    End If
    
    Exit Sub
EH:
    frmClose.lstCloseStatus.AddItem Err.Description

End Sub
'---------------------------------------------------------------------------------------
' Module    : SetPkgManifestStatus
' DateTime  : 4/14/2005
' Author    : Chris Elwell
' Purpose   : Updates the ManifestStatus flag in SmartPost table to show package has been
'             closed.
'---------------------------------------------------------------------------------------
'
Private Sub SetPkgManifestStatus(ByVal strTrkNum As String)

    On Error GoTo EH
    
    Dim strQuery As String
    
    strQuery = "UPDATE SmartPost SET [ManifestStatus] = 'C' WHERE g_str29 =" & SingleQuotes(strTrkNum)
    
    g_connFSMSClient.Execute strQuery
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:SetPkgManifestStatus"
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : ChangeManifestName
' DateTime  : 4/14/2005
' Author    : Chris Elwell
' Purpose   : Once a manifest has been transmitted rename with ."TXD" extension.
'---------------------------------------------------------------------------------------
'
Private Sub ChangeManifestName(ByVal strPath As String, ByVal strManifestID As String)

    On Error GoTo EH
    
    Dim FSO As New FileSystemObject
    FSO.CopyFile strPath & strManifestID, strPath & FSO.GetBaseName(strManifestID) & ".TXD", True
    FSO.DeleteFile strPath & strManifestID, True

Release:
    Set TSO = Nothing
    Set FSO = Nothing
    
    Exit Sub

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:SaveManifestStatus"
    Resume Release
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : RateSP
' DateTime  : 4/14/2005
' Author    : Chris Elwell
' Purpose   : Pass weight, zip and class to Rate an SP package. Returns rate in string or
'             returns error message.
'---------------------------------------------------------------------------------------
'
Public Function RateSP(ByVal strZip As String, ByVal strWgt As String, ByVal strClass As String) As String

    On Error GoTo EH
    
    Dim strQuery As String
    Dim rsRate As New ADODB.Recordset
    Dim rsZone As New ADODB.Recordset
    
    strQuery = "SELECT Zone FROM ZipToZone WHERE " & SingleQuotes(strZip) & " >= BeginZip"
    strQuery = strQuery + " And " & SingleQuotes(strZip) & " <= EndZip"
    rsZone.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    'Check for Oversize, set to 71 if Length + Girth > 108
    If SPDIMsCheck(g_str57, g_str58, g_str59) > 108 Then
        strWgt = 71
    End If
    
    'Set query based on Class and Zone
    If Not rsZone.EOF Then
        g_strZone = rsZone!Zone
        If strClass = "A" Then
            strQuery = "SELECT Weight, Rate FROM StdARates WHERE Zone = " & SingleQuotes(g_strZone)
        ElseIf strClass = "B" Then
            strQuery = "SELECT Weight, Rate FROM StdBRates WHERE Zone = " & SingleQuotes(g_strZone)
        ElseIf strClass = "F" Then
            strQuery = "SELECT Weight, Rate FROM PriorityMailRates WHERE Zone = " & SingleQuotes(g_strZone)
        End If
        rsRate.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
        
        'Loop until weight passed is less <= weight for that record
        Do Until rsRate.EOF
            If Val(strWgt) <= Val(rsRate!Weight) Then
                RateSP = rsRate!Rate
                g_str37 = rsRate!Rate
                g_str60 = rsRate!Weight
                '20071106-01 Added new hook
                Call AfterRateQuote
                GoTo Release
            End If
            
            rsRate.MoveNext
        Loop
        'Rate Error
        RateSP = "-1"
        
    Else
        'Zip not found
        RateSP = "-2"
    End If

Release:
    If rsRate.State = adStateOpen Then rsRate.Close
    Set rsRate = Nothing
    If rsZone.State = adStateOpen Then rsZone.Close
    Set rsZone = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:RateSP"
    Resume Release
    RateSP = "-1"
    
End Function
'---------------------------------------------------------------------------------------
' Module    : TrackSPByTrkNum
' DateTime  : 4/14/2005
' Modified  : 9/14/2005 - Updated new SmartPost URL text.
' Author    : Chris Elwell
' Purpose   : Tracks the passed tracking number on ParcelDirect web site
' Call from : TrackButton
'---------------------------------------------------------------------------------------
'
Public Sub TrackSPByTrkNum(ByVal strCustID As String, ByVal strTrackNum As String)

    On Error GoTo EH
    
    With frmShip
        .SSTab1.Tab = 4
        .WebBrowser1.Navigate "http://spportal.fedex.com/sp/tracking.htm?bgcolor=%23ecece1&CID=" & strCustID & "&PID=" & strTrackNum
        .StatusBar1.Panels(2) = "Tracking, please wait..."
    End With
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:TrackSPByTrkNum"
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : CloseSmartPost
' DateTime  : 4/14/2005
' Author    : Chris Elwell
' Purpose   : Calls routine to build close file then calls routine to send FTP files or
'             shows error message on close form status box.
' Call from : frmClose:CloseMeters
'---------------------------------------------------------------------------------------
'
Public Sub CloseSmartPost()

    On Error GoTo EH
    Dim strFilename As String
    
    Dim FSO As New Scripting.FileSystemObject
    
    'Build FTP and get filename
    strFilename = BuildFTPFile
    'If blank there are no SmartPost records
    With frmClose
        If strFilename = "" Then
            .lstCloseStatus.AddItem "No SmartPost Shipments!"
        'ElseIf FILEERROR is returned there was an error building the file
        ElseIf strFilename = "FILEERROR" Then
            .lstCloseStatus.AddItem "Error building SmartPost File!"
        'Else Send the FTP file
        Else
            'Send SmartPost file
            .lstCloseStatus.AddItem "Transmitting SmartPost File..."
            Call SendFTPFile
            'Send Emails
            Call StartEmail
            '20070827-01 Delete all SmartPost labels after closing.
            On Error Resume Next
            
            'Kill App.Path & "\Labels\*.*"
            FSO.DeleteFile App.Path & "\Labels\*.*", True

            
            On Error GoTo EH
        End If
    End With
    'Used to control multiple closes
    g_blnNextClose = True
    
    '02/27/06 Added AfterClose hook sub call
    Call AfterClose
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:CloseSmartPost"
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : ProcessSPBatch
' DateTime  : 4/14/2005
' Author    : Chris Elwell
' Purpose   : Processes SmartPost AND SP+ Batch shipments
'---------------------------------------------------------------------------------------
'
Public Sub ProcessSPBatch(ByVal strFile As String)
    Dim strFields() As String
    Dim FSO As New Scripting.FileSystemObject
    Dim fsoFileIn As Scripting.TextStream
    Dim i As Integer
    Dim j As Integer
    Dim strTrans As String
    Dim strDelimIn As String
    Dim strQualIn As String
    Dim intUboundInputFlds As Integer
    Dim ret
    Dim strMultiFields() As String
    
    On Error GoTo EH
    
    'CIC defineable routine. See end of this module.
    Call BeforeBatch
    
    Set fsoFileIn = FSO.OpenTextFile(strFile, ForReading)
    
    g_lngErrorCount = 0
    g_lngShipCount = 0
    '6/30/06 used in Batch Addr Verify
    g_lngSoftErrorCount = 0
    
    
    Do While Not fsoFileIn.AtEndOfStream
            
        If g_blnAbortBatch Then
            ret = MsgBox("Click OK to resume processing, click Cancel to abort processing.", vbOKCancel, "Batch Processing Paused")
    
            If ret = vbOK Then
                g_blnAbortBatch = False
            Else
                Exit Do
            End If
        End If
        
        'Set the delimiter in the input transaction
        With frmSetup
            'Get total fields configured on Batch Input tab
            For i = 0 To .txtInputFld.UBound
                If .txtInputFld(i) <> "" Then
                    intUboundInputFlds = i
                End If
            Next
            Select Case .cboDelimIn
                Case "Comma"
                    strDelimIn = ","
                Case "Tab"
                    strDelimIn = vbTab
                Case "Pipe"
                    strDelimIn = "|"
                Case "Tilde"
                    strDelimIn = "`"
            End Select
            
            '11/08/05 added qualifier
            Select Case .cboQualIn
                Case "None"
                    strQualIn = ""
                Case Chr(34)
                    strQualIn = Chr(34)
                Case "'"
                    strQualIn = "'"
            End Select
                    
                
           'Read a line
            g_strLine = fsoFileIn.ReadLine
            
            '11/08/05 Split the input into an array using the delimiter and qualified from above
            strFields = Split(g_strLine, strQualIn & strDelimIn & strQualIn)
            
            '11/28/06 Clear out CUST vars
            For i = 0 To 9
                For j = 0 To 9
                    g_strCUST(i, j) = ""
                Next
            Next
            
            '20070510-03 Use the smaller of the # of fields in the file or the # configured on Batch Input tab
            intCount = IIf(UBound(strFields) <= intUboundInputFlds, UBound(strFields), intUboundInputFlds)
                
            strTrans = ""
            'Deletes
            If UBound(strFields) = 0 Then
                Call DeleteSPPkg(strFields(0))
            'Shipping
            Else
                'Add fields sent from customer
                For i = 0 To UBound(strFields)
                    '11/08/05 Remove the qualifier on first and last fields
                    If i = 0 And strQualIn <> "" Then
                        strFields(i) = Right(strFields(i), Len(strFields(i)) - 1)
                    ElseIf i = UBound(strFields) And strQualIn <> "" Then
                        strFields(i) = Replace(strFields(i), strQualIn, "")
                    End If
                    
                    If Trim(.txtInputFld(i)) <> "N/A" Then
                        strMultiFields = Split(.txtInputFld(i), "&")
                        For j = 0 To UBound(strMultiFields)
                            Select Case UCase(strMultiFields(j))
                                Case "1"
                                    g_str1 = strFields(i)
                                Case "11"
                                    g_str11 = strFields(i)
                                Case "12"
                                    g_str12 = strFields(i)
                                Case "13"
                                    g_str13 = strFields(i)
                                Case "14"
                                    g_str14 = strFields(i)
                                Case "15"
                                    g_str15 = strFields(i)
                                Case "16"
                                    g_str16 = strFields(i)
                                Case "17"
                                    g_str17 = Left(strFields(i), 5)
                                Case "24"
                                    g_str24 = strFields(i)
                                Case "25"
                                    g_str25 = strFields(i)
                                Case "1670"
                                    '03/09/06 Format wieght to 2 decimal places
                                    g_str1670 = Format(strFields(i), "##.00")
                                Case "3056"
                                    g_str3056 = strFields(i)
                                Case "CLASS"
                                    g_strClass = strFields(i)
                                Case "SUB-CLASS"
                                    g_strSubClass = strFields(i)
                                '20070828-01 Added Endorsement to Batch Input processing
                                Case "ENDORSEMENT"
                                    g_strEndorsement = strFields(i)
                                'Following fields added to support SP Email Alerts
                                Case "1202"                     'Recipient Email
                                    g_str1202 = strFields(i)
                                Case "1201"                     'Sender Email
                                    g_str1201 = strFields(i)
                                Case "1554"                     'Sender Shipment Notification flag
                                    g_str1554 = strFields(i)
                                Case "1204-1"                   'Other 1 Email
                                    g_str1204_1 = strFields(i)
                                Case "1204-2"                   'Other 2 Email
                                    g_str1204_2 = strFields(i)
                                Case "1204-3"                   'Other 3 Email
                                    g_str1204_3 = strFields(i)
                                Case "1203"                     'Email message
                                    g_str1203 = strFields(i)
                            End Select
                        Next
                    End If
                Next
                '05/01/06 Added for SP Batch Defaults
                'Set default values
                For i = 0 To .txtFieldNum.UBound
                    Select Case .txtFieldNum(i)
                        Case "1"
                            g_str1 = .txtValue(i)
                        Case "25"
                            g_str25 = .txtValue(i)
                        Case "1670"
                            '20070531-01 Fixed using incorrect variable name.
                            g_str1670 = Format(.txtValue(i), "##.00")
                        Case "3056"
                            g_str3056 = .txtValue(i)
                        Case "CLASS"
                            g_strClass = .txtValue(i)
                        Case "SUB-CLASS"
                            g_strSubClass = .txtValue(i)
                        '20070613-04 Added ancillary endorsement to batch defaults
                        Case "ENDORSEMENT"
                            g_strEndorsement = SetSPEndorsement(.txtValue(i))
                        Case "1201"                     'Sender Email
                            g_str1201 = .txtValue(i)
                    End Select
                Next
                'Service code
                g_str1274 = "99"
                'Shipdate
                If g_str24 = "" Then g_str24 = CStr(Date)
                'Country
                g_str50 = "US"
            End If
        End With
        '20070822-02 Modified BeforeBatchShip to return a Boolean.
        If BeforeBatchShip Then
            Call ShipSmartPostBatch
        End If
    Loop
    
Release:
    Set fsoFileIn = Nothing
    Set FSO = Nothing
    
    Call AfterBatch
    
    Exit Sub

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:ProcessSPBatch"
    Resume Release
    
End Sub

'20070327-07 Removed ProcessSPPlusBatch

'---------------------------------------------------------------------------------------
' Module    : DeleteSPPkg
' DateTime  : 4/27/2005
' Author    : Chris Elwell
' Purpose   : Changes the status of a SmartPost shipment to Deleted.
'           : 4 different return values: 0 = Successful delete, 1 = pkg already deleted
'           : 2 = pkg already manifested, 3 = trk# not found
'---------------------------------------------------------------------------------------
'
Public Function DeleteSPPkg(ByVal strTrkNum As String) As Integer
    
    On Error GoTo EH
    
    Dim strQuery As String
    Dim strQuery2 As String
    Dim rsTrkNum As New ADODB.Recordset
    
    'First part of query doesn't change
    strQuery = "SELECT g_str29 FROM SmartPost WHERE g_str29 = " & SingleQuotes(strTrkNum)
    'Check for Shipped Status and not been manifested.
    strQuery2 = " AND Status = 'Shipped' And ManifestStatus = 'O'"
    rsTrkNum.Open strQuery + strQuery2, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    If Not rsTrkNum.EOF Then
        strQuery = "UPDATE SmartPost SET Status = 'Deleted' WHERE g_str29 = " & SingleQuotes(strTrkNum)
        g_connFSMSClient.Execute strQuery
        '03/14/06 Delete Email file
        Call DeleteEmailFile(App.Path & "\Email\" & Format(CStr(Date), "YYYYMMDD") _
                            & "\" & strTracking & ".htm")
        DeleteSPPkg = 0
        GoTo Release
    Else
        'Check to see if already Deleted
        strQuery2 = " AND Status = 'Deleted'"
        If rsTrkNum.State = adStateOpen Then rsTrkNum.Close
        rsTrkNum.Open strQuery + strQuery2, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
        If Not rsTrkNum.EOF Then
            DeleteSPPkg = 1
            GoTo Release
        Else
            'Check to see if already Manifested
            strQuery2 = " AND ManifestStatus = 'C'"
            If rsTrkNum.State = adStateOpen Then rsTrkNum.Close
            rsTrkNum.Open strQuery + strQuery2, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
            If Not rsTrkNum.EOF Then
                DeleteSPPkg = 2
                GoTo Release
            Else
                'Finally just check to see if it exists
                If rsTrkNum.State = adStateOpen Then rsTrkNum.Close
                rsTrkNum.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
                If rsTrkNum.EOF Then
                    DeleteSPPkg = 3
                End If
            End If
        End If
    End If
    
Release:
    g_blnComplete = True
    If rsTrkNum.State = adStateOpen Then rsTrkNum.Close
    Set rsTrkNum = Nothing
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, "modSmartPost:DeleteSPPkg"
    Resume Release
    
End Function
'---------------------------------------------------------------------------------------
' Procedure : WriteSPBatchError()
' DateTime  : 4/15/2005
' Purpose   : Writes out SP and SPPlus Batch Errors
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub WriteSPBatchError()
    
    Dim strPath As String
    Dim strDelimIn As String
    '05/01/06
    Dim strQualIn As String
    
    On Error GoTo EH
    
    With frmSetup
        'Set the delimiter in the input transaction
        Select Case .cboDelimIn
            Case "Comma"
                strDelimIn = ","
            Case "Tab"
                strDelimIn = vbTab
            Case "Pipe"
                strDelimIn = "|"
            Case "Tilde"
                strDelimIn = "`"
        End Select
        '05/01/06 added qualifier
        Select Case .cboQualIn
            Case "None"
                strQualIn = ""
            Case Chr(34)
                strQualIn = Chr(34)
            Case "'"
                strQualIn = "'"
        End Select
    End With
    'Set path to program path or File Path defined on Setup Batch Defaults tab
    If frmSetup.txtFilesPath = "" Then
        strPath = App.Path
    Else
        strPath = frmSetup.txtFilesPath
    End If
    
    With frmShip
        'Write error message and transaction text to file
        Open strPath & "\BatchErrors_" & Format(Date, "YYYYMMDD") & ".txt" For Append As #1
        'Added code to handle rating errors when performing Batch Error Check
        If g_str3 <> "" Then
            '05/01/06 updated to add qualifier
            Print #1, strQualIn & g_str3 & strQualIn & strDelimIn & g_strLine
            g_lngErrorCount = g_lngErrorCount + 1
        End If
        
        Close #1
        .txtNumErrors = Str(g_lngErrorCount)
        .txtTotalRecords = Str(g_lngShipCount + g_lngErrorCount)
        If Not g_blnBatchErrorCheck Then
            '05/01/06 Updated to add qualifier to error msg
            .lstErrorTransactions.AddItem strQualIn & g_str3 & strQualIn & strDelimIn & g_strLine
        End If
    End With
    
    Exit Sub
EH:
     MsgBox Err.Description, vbCritical, "modSmartPost:WriteSPBatchError"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : WriteSPBatchReply()
' DateTime  : 4/15/2005
' Purpose   : Use this routine to handle FXRS reply data
' Call from : frmShip.g_clsParser_ParseComplete()
'---------------------------------------------------------------------------------------
'
Public Sub WriteSPBatchReply()
    Dim strPath As String
    Dim strLineOut As String
    Dim strDelimOut As String
    Dim strQualOut As String
    Dim intUboundOutputFlds As Integer
    Dim i As Integer
    
    On Error GoTo EH
    
    With frmSetup
        'Get the number of output fields
        For i = 0 To .txtOutputFld.UBound
            If .txtOutputFld(i) <> "" Then intUboundOutputFlds = i
        Next
        'Get the output delimiter
        Select Case .cboDelimOut
            Case "Comma"
                strDelimOut = ","
            Case "Tab"
                strDelimOut = vbTab
            Case "Pipe"
                strDelimOut = "|"
            Case "Tilde"
                strDelimOut = "`"
        End Select
        'Get output text qualifier
        strQualOut = IIf(.cboQualOut = "None", "", .cboQualOut)
        
        'Set path to program path or File Path defined is Setup Batch Defaults tab
        strPath = IIf(.txtFilesPath = "", App.Path, .txtFilesPath)
        
        'Add Input Fields to Output file if configured
        If .chkAddInputToOutput = 1 Then strLineOut = g_strLine & strDelimOut
        
    End With
    
    With frmSetup
        'These are the only fields available for Output. The line in can be added if
        'recipient fields are need in the output file.
        For i = 0 To intUboundOutputFlds
            Select Case .txtOutputFld(i)
                Case "1"
                    strLineOut = strLineOut & strQualOut & g_str1 & strQualOut & strDelimOut
                Case "25"
                    strLineOut = strLineOut & strQualOut & g_str25 & strQualOut & strDelimOut
                Case "29"
                    strLineOut = strLineOut & strQualOut & g_str29 & strQualOut & strDelimOut
                Case "37"
                    strLineOut = strLineOut & strQualOut & g_str37 & strQualOut & strDelimOut
                Case "60"
                    strLineOut = strLineOut & strQualOut & g_str60 & strQualOut & strDelimOut
                Case "3056"
                    strLineOut = strLineOut & strQualOut & g_str3056 & strQualOut & strDelimOut
                Case "DCB"
                    strLineOut = strLineOut & strQualOut & g_strDCB & strQualOut & strDelimOut
                Case "CLASS"
                    strLineOut = strLineOut & strQualOut & g_strClass & strQualOut & strDelimOut
                Case "SUB-CLASS"
                    strLineOut = strLineOut & strQualOut & g_strSubClass & strQualOut & strDelimOut
            End Select
        Next
    End With
    
    'Remove last delimiter
    strLineOut = Left(strLineOut, Len(strLineOut) - 1)
    
    'Increment shipped counter
    g_lngShipCount = g_lngShipCount + 1
    
    'Update Batch tab with totals
    With frmShip
        .txtNumShipped = Str(g_lngShipCount)
        .txtTotalRecords = Str(g_lngShipCount + g_lngErrorCount)
        .Refresh
    End With

    'Write reply fields to output file
    Open strPath & "\BatchReply_" & Format(Date, "YYYYMMDD") & ".txt" For Append As #1
    Print #1, strLineOut
    Close #1
    
    Exit Sub
EH:
     MsgBox Err.Description, vbCritical, "modSmartPost:WriteSPBatchReply"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : URLEncode()
' DateTime  : 4/29/2005
' Purpose   : Converts text with special characters to URL encoded characters
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function URLEncode(ByVal strText As String) As String
    
    On Error GoTo EH
    
    Dim strURLText As String
    Dim i As Integer
    
    If Len(strText) > 0 Then

        For i = 1 To Len(strText)
            Select Case Asc(Mid(strText, i, 1))
                Case 48 To 57, 65 To 90, 97 To 122, 46, 45, 95, 42 '0-9, A-Z, a-z . - _ *
                    strURLText = strURLText & Mid(strText, i, 1)
                Case 32
                    strURLText = strURLText & "+"
                Case Else
                    strURLText = strURLText & "%" & Right("0" & Hex(Asc(Mid(strText, i, 1))), 2)
            End Select
        Next
    
    End If

    URLEncode = strURLText
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, "modSmartPost:WriteSPBatchReply"

End Function
'---------------------------------------------------------------------------------------
' Procedure : CleanSPRef()
' DateTime  : 4/29/2005
' Purpose   : Removes disallowed characters from reference string
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function CleanSPRef(ByRef MyControl As Control)
    
    On Error GoTo EH
    
    Dim strRefOut As String
    Dim i As Integer
    
    If Len(MyControl) > 0 Then

        For i = 1 To Len(MyControl)
            Select Case Asc(Mid(MyControl, i, 1))
                Case 48 To 57, 65 To 90, 97 To 122, 45 '0-9, A-Z, a-z, and - allowed
                    strRefOut = strRefOut & Mid(MyControl, i, 1)
            End Select
        Next
    
    End If

    MyControl = strRefOut
    MyControl.SelStart = Len(MyControl)
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, "modSmartPost:CleanSPRef"

End Function
'---------------------------------------------------------------------------------------
' Module    : ReprintSPLabel
' DateTime  : 20070928-01 Totally re-vamped
' Author    : Chris Elwell
' Purpose   : Called from the frmLblReprint if reprinting a SmartPost label.
'---------------------------------------------------------------------------------------
'
Public Sub ReprintSPLabel(ByVal strDCB As String)
    
    On Error GoTo EH
  
    Dim FSO As New FileSystemObject
    Dim strFileSpec As String
        
    'Create Filespec
    strFileSpec = App.Path & "\Labels\" & strDCB & ".txt"
    
    If Not FSO.FileExists(strFileSpec) Then
        MsgBox "Tracking # " & strDCB & " not found.", vbCritical, "Label Re-print Error"
    Else
        'Only print and delete if UNC not blank
        If g_str537 <> "" Then
            FSO.CopyFile strFileSpec, g_str537
        End If
    End If
    
    
Release:
    Set FSO = Nothing
    
    Exit Sub

EH:

    MsgBox Err.Description, vbCritical, "modSmartPost:PrintSmartPostLabel"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Module    : SetSPEndorsement
' DateTime  : 6/13/2007
' Author    : Chris Elwell
' Purpose   : Returns endorsement text for value passed
'---------------------------------------------------------------------------------------
'
Private Function SetSPEndorsement(ByVal strValue As String) As String

    Select Case strValue
        Case "1"
            SetSPEndorsement = "Carrier Leave If No Response"
        Case "2"
            SetSPEndorsement = "Address Correction Requested"
        Case "3"
            SetSPEndorsement = "Forwarding Service Requested"
        Case "4"
            SetSPEndorsement = "Return Service Requested"
        Case "5"
            SetSPEndorsement = "Change Service Requested"
    End Select

End Function
